Sound Fx

home *** CD-ROM | disk | FTP | other *** search

/ Sound Fx / Sound Fx.iso / Software / UNZIPED / DWSTKW / VB / VB4 / PLAY16 / PLAYSTK.FRM (.txt) < prev next >

Wrap

Visual Basic Form | 1996-03-24 | 22.0 KB | 678 lines

VERSION 4.00 Begin VB.Form frmMain Appearance = 0 'Flat BackColor = &H00C0C0C0& ClientHeight = 3525 ClientLeft = 1770 ClientTop = 3255 ClientWidth = 7020 BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 700 size = 8.25 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 3930 Icon = "PLAYSTK.frx":0000 Left = 1710 LinkTopic = "Form1" ScaleHeight = 3525 ScaleWidth = 7020 Top = 2910 Width = 7140 Begin VB.VScrollBar vsbModifier Height = 2370 Index = 2 Left = 5250 Max = 16 Min = 1 TabIndex = 11 Top = 615 Value = 1 Width = 285 End Begin VB.VScrollBar vsbModifier Height = 2370 Index = 1 Left = 4635 Max = 16 Min = 1 TabIndex = 10 Top = 615 Value = 1 Width = 285 End Begin VB.CommandButton cmdCommand Appearance = 0 'Flat BackColor = &H80000005& Caption = "&Remove" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 8.25 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 360 Index = 3 Left = 3105 TabIndex = 9 Top = 3060 Width = 900 End Begin VB.CommandButton cmdCommand Appearance = 0 'Flat BackColor = &H80000005& Caption = "&Stop" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 8.25 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 360 Index = 2 Left = 2100 TabIndex = 8 Top = 3060 Width = 900 End Begin VB.CommandButton cmdCommand Appearance = 0 'Flat BackColor = &H80000005& Caption = "&Play" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 8.25 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 360 Index = 1 Left = 1110 TabIndex = 7 Top = 3060 Width = 900 End Begin VB.OptionButton optRate Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "44,100kHZ" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 8.25 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 225 Index = 2 Left = 5715 TabIndex = 6 Top = 2745 Width = 1250 End Begin VB.OptionButton optRate Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "22,050kHZ" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 8.25 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 225 Index = 1 Left = 5715 TabIndex = 5 Top = 2445 Width = 1250 End Begin VB.CheckBox chkLR Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = " Left<->Right" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 8.25 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 285 Left = 5700 TabIndex = 4 Top = 825 Width = 1215 End Begin VB.OptionButton optRate Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "11,025kHZ" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 8.25 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 225 Index = 0 Left = 5715 TabIndex = 3 Top = 2130 Value = -1 'True Width = 1250 End Begin VB.VScrollBar vsbModifier Height = 2370 Index = 0 Left = 4200 Max = 16 Min = 1 TabIndex = 2 Top = 615 Value = 1 Width = 285 End Begin VB.CommandButton cmdCommand Appearance = 0 'Flat BackColor = &H80000005& Caption = "&New" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 8.25 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 360 Index = 0 Left = 135 TabIndex = 1 Top = 3060 Width = 900 End Begin VB.ListBox lstSounds Appearance = 0 'Flat Height = 2370 Left = 135 TabIndex = 0 Top = 615 Width = 3990 End Begin VB.Label lblLabel Alignment = 2 'Center Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "Pitch" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 8.25 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 255 Index = 4 Left = 5130 TabIndex = 16 Top = 3060 Width = 510 End Begin VB.Label lblLabel Alignment = 2 'Center Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "Volume" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 8.25 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 255 Index = 3 Left = 4230 TabIndex = 15 Top = 3060 Width = 705 End Begin VB.Label lblLabel Alignment = 2 'Center Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "R" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 8.25 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 255 Index = 2 Left = 4650 TabIndex = 14 Top = 315 Width = 255 End Begin VB.Label lblLabel Alignment = 2 'Center Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "L" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 8.25 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 255 Index = 1 Left = 4200 TabIndex = 13 Top = 315 Width = 255 End Begin VB.Label lblLabel Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "List of Sounds and Music to Play" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 400 size = 8.25 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 255 Index = 0 Left = 795 TabIndex = 12 Top = 180 Width = 2445 End Begin VB.Image imgIcon Appearance = 0 'Flat Height = 480 Left = 165 Picture = "PLAYSTK.frx":030A Top = 60 Width = 480 End Begin MSComDlg.CommonDialog dlgFile Left = 6480 Top = 75 _version = 65536 _extentx = 847 _extenty = 847 _stockprops = 0 End Attribute VB_Name = "frmMain" Attribute VB_Creatable = False Attribute VB_Exposed = False Option Explicit Const I_CMD_LOAD = 0 Const I_CMD_PLAY = 1 Const I_CMD_STOP = 2 Const I_CMD_REMOVE = 3 Const I_VSB_LVOL = 0 Const I_VSB_RVOL = 1 Const I_VSB_PITCH = 2 Const I_OPT_11K = 0 Const I_OPT_22K = 1 Const I_OPT_44K = 2 Dim miLastSoundNum As Integer Dim milDir As Integer Dim mirDir As Integer Private Sub chkLR_Click() Dim iResult As Integer iResult = dws_DClear() iResult = dws_MClear() iResult = dws_Kill() If chkLR.Value = False Then t_dws_ID.flags = 0 Else t_dws_ID.flags = dws_ideal_SWAPLR End If If dws_Init(t_dws_DR, t_dws_ID) = dws_NOSUCCESS Then dwsShowError End If End Sub Private Sub cmdCommand_Click(Index As Integer) Dim sString As String Dim iIndex As Integer Dim iStatus As Integer Dim iResult As Integer On Error GoTo CCE Select Case Index Case I_CMD_STOP iResult = dws_MClear() iResult = dws_DClear() Case I_CMD_LOAD ' Load a default dlgFile.FileName = "" dlgFile.InitDir = App.Path dlgFile.Filter = "Wave, DWD, MIDI Files (*.wav;*.dwd;*.mid)|*.wav;*.dwd;*.mid" dlgFile.Action = CD_ACTION_OPEN sString = dlgFile.FileName If Len(sString) Then If InStr(UCase(sString), ".MID") Then lstSounds.AddItem sString lstSounds.ItemData(lstSounds.ListCount - 1) = -1 ElseIf InStr(UCase(sString), ".WAV") Then iIndex = dwsLoadWave(sString) If iIndex > -1 Then lstSounds.AddItem CStr(gtSI(iIndex).Rate) + ", " + sString lstSounds.ItemData(lstSounds.ListCount - 1) = iIndex End If ElseIf InStr(UCase(sString), ".DWD") Then iIndex = dwsLoadWave(sString) If iIndex > -1 Then lstSounds.AddItem CStr(gtSI(iIndex).Rate) + ", " + sString lstSounds.ItemData(lstSounds.ListCount - 1) = iIndex End If End If lstSounds.ListIndex = (lstSounds.ListCount - 1) vsbModifier_Change 0 End If Case I_CMD_PLAY If lstSounds.ListIndex > -1 Then If lstSounds.ItemData(lstSounds.ListIndex) = -1 Then ' MIDI! Dim tMPlay As dws_MPlay tMPlay.track = lstSounds.List(lstSounds.ListIndex) tMPlay.count = 1 iStatus = dws_MPlay(tMPlay) If iStatus = 0 Then dwsShowError End If Else iResult = dwsPlayWave(CInt(lstSounds.ItemData(lstSounds.ListIndex))) miLastSoundNum = gtSI(lstSounds.ItemData(lstSounds.ListIndex)).soundnum End If End If Case I_CMD_REMOVE If lstSounds.ListIndex > -1 Then If lstSounds.ItemData(lstSounds.ListIndex) > -1 Then ' A Wave! If Not dwsUnloadWave(CInt(lstSounds.ItemData(lstSounds.ListIndex))) Then MsgBox "Error unloading Wave File!" End If End If lstSounds.RemoveItem lstSounds.ListIndex End If Case Else End Select CCER: Exit Sub MsgBox "Error '" + Error + "' occurred in FRMMAIN:cmdCommand_Click!" Resume CCER End Sub Private Sub Form_Load() ' Center the form! Dim sString As String Dim lResult As Long ReDim gtSI(0) As SoundInfo Me.Move (Screen.Width / 2) - (Me.Width / 2), (Screen.Height / 2) - (Me.Height / 2) If dws_DetectHardWare(t_dws_DR) = dws_NOSUCCESS Then dwsShowError End End If ' No sound card (or something that's weird) If t_dws_DR.digcaps = 0 Then MsgBox "Your computer does not support sound playback.", 64, "Sound Toolkit Error" End End If ' Does the sound card support the minimum requirements? If (t_dws_DR.digcaps And dws_digcap_11025_08_2) = False Then sString = "DiamondWare's Sound ToolKit for Windows supports sound playback on your computer. " sString = sString + "However, this demo requires 8-bit stereo " sString = sString + "which your computer does not support. " sString = sString + "Your sound hardware does not support " sString = sString + "11025Hz, two channel, 8 bit sound " sString = sString + "This demo will not run properly on your computer." MsgBox sString, 64, "Sound Toolkit Error" End End If ' Detect and select the best MIDI deivce to use! If t_dws_DR.muscaps And dws_muscap_MAPPER Then lResult = dws_muscap_MAPPER ElseIf t_dws_DR.muscaps And dws_muscap_FMSYNTH Then lResult = dws_muscap_FMSYNTH ElseIf t_dws_DR.muscaps And dws_muscap_SYNTH Then lResult = dws_muscap_SYNTH ElseIf t_dws_DR.muscaps And dws_muscap_SQSYNTH Then lResult = dws_muscap_SQSYNTH ElseIf t_dws_DR.muscaps And dws_muscap_MIDIPORT Then lResult = dws_muscap_MIDIPORT End If ' Set up the 'ideal' music type! t_dws_ID.mustyp = lResult t_dws_ID.digtyp = dws_digcap_11025_08_2 t_dws_ID.dignvoices = 6 If dws_Init(t_dws_DR, t_dws_ID) = dws_NOSUCCESS Then dwsShowError End If vsbModifier(I_VSB_LVOL).Value = 8 vsbModifier(I_VSB_RVOL).Value = 8 vsbModifier(I_VSB_PITCH).Value = 8 End Sub Private Sub Form_Unload(Cancel As Integer) Dim iLoop As Integer Dim iResult As Integer iResult = dws_DClear() iResult = dws_MClear() ' Unload all loaded wave files! If giNumSounds > 0 Then For iLoop = 0 To UBound(gtSI) iResult = dwsUnloadWave(iLoop) Next iLoop End If If dws_Kill() = dws_NOSUCCESS Then dwsShowError End If End Sub Private Sub lstSounds_DblClick() cmdCommand_Click (I_CMD_PLAY) End Sub Private Sub optRate_Click(Index As Integer) Dim iResult As Integer iResult = dws_DClear() iResult = dws_MClear() iResult = dws_Kill() Select Case Index Case I_OPT_11K t_dws_ID.digtyp = dws_digcap_11025_08_2 Case I_OPT_22K t_dws_ID.digtyp = dws_digcap_22050_08_2 Case I_OPT_44K t_dws_ID.digtyp = dws_digcap_44100_08_2 Case Else End Select If dws_Init(t_dws_DR, t_dws_ID) = dws_NOSUCCESS Then dwsShowError End If End Sub Private Sub vsbModifier_Change(Index As Integer) Dim iStatus As Integer Dim iValue As Integer Dim iValue2 As Integer Dim iIndex As Integer Dim iResult As Integer ' Are we changing the volume of a WAVE or MIDI? If lstSounds.ListIndex > -1 Then If lstSounds.ItemData(lstSounds.ListIndex) = -1 Then ' It's a MIDI! iValue = ((16 - vsbModifier(I_VSB_LVOL).Value) * 16) - 1 iValue2 = ((16 - vsbModifier(I_VSB_RVOL).Value) * 16) - 1 'dws_XMusic iValue, iValue2 Exit Sub End If End If ' Assign the Sound Num If lstSounds.ListIndex = -1 Then gPlay.soundnum = 0 Else iIndex = lstSounds.ItemData(lstSounds.ListIndex) gPlay.soundnum = gtSI(iIndex).soundnum End If ' Get the current play information associated ' with the sound num. iResult = dws_DGetInfo(gPlay, ByVal 0&) ' Adjsut the value Select Case Index Case I_VSB_PITCH iValue = vsbModifier(Index).Value Case Else iValue = (16 - vsbModifier(Index).Value) End Select If iValue >= 8 Then iValue = (iValue - 7) * 256 Else iValue = iValue * 32 End If Select Case Index Case I_VSB_LVOL gPlay.flags = dws_dplay_LVOL gPlay.lvol = iValue Case I_VSB_RVOL gPlay.flags = dws_dplay_RVOL gPlay.rvol = iValue Case I_VSB_PITCH gPlay.flags = dws_dplay_PITCH gPlay.pitch = iValue Case Else End Select If lstSounds.ListIndex = -1 Then gPlay.soundnum = 0 Else gPlay.soundnum = gtSI(iIndex).soundnum End If ' Assign the new Play Information iResult = dws_DSetInfo(gPlay, ByVal 0&) End Sub Private Sub vsbModifier_Scroll(Index As Integer) Dim iStatus As Integer Dim iValue As Integer Dim iValue2 As Integer Dim iIndex As Integer Dim iResult As Integer ' Are we changing the volume of a WAVE or MIDI? If lstSounds.ListIndex > -1 Then If lstSounds.ItemData(lstSounds.ListIndex) = -1 Then ' It's a MIDI! iValue = ((16 - vsbModifier(I_VSB_LVOL).Value) * 16) - 1 iValue2 = ((16 - vsbModifier(I_VSB_RVOL).Value) * 16) - 1 't_dws_XMusic iValue, iValue2 Exit Sub End If End If ' Assign the Sound Num If lstSounds.ListIndex = -1 Then gPlay.soundnum = 0 Else iIndex = lstSounds.ItemData(lstSounds.ListIndex) gPlay.soundnum = gtSI(iIndex).soundnum End If ' Get the current play information associated ' with the sound num. iResult = dws_DGetInfo(gPlay, ByVal 0&) ' Adjsut the value Select Case Index Case I_VSB_PITCH iValue = vsbModifier(Index).Value Case Else iValue = (16 - vsbModifier(Index).Value) End Select If iValue >= 8 Then iValue = (iValue - 7) * 256 Else iValue = iValue * 32 End If Select Case Index Case I_VSB_LVOL gPlay.flags = dws_dplay_LVOL gPlay.lvol = iValue Case I_VSB_RVOL gPlay.flags = dws_dplay_RVOL gPlay.rvol = iValue Case I_VSB_PITCH gPlay.flags = dws_dplay_PITCH gPlay.pitch = iValue Case Else End Select If lstSounds.ListIndex = -1 Then gPlay.soundnum = 0 Else gPlay.soundnum = gtSI(iIndex).soundnum End If ' Assign the new Play Information iResult = dws_DSetInfo(gPlay, ByVal 0&) End Sub